home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / C / Applications / Moscow ML 1.31 / source code / mosml / src / mosmllib / Substring.sml < prev    next >
Encoding:
Text File  |  1996-07-03  |  4.9 KB  |  163 lines  |  [TEXT/R*ch]
  1. (* Substring -- 1995-06-15 *)
  2.  
  3. local 
  4.     prim_val sub_      : string -> int -> char         = 2 "get_nth_char";
  5.     prim_val mkstring_ : int -> string                 = 1 "create_string";
  6.     prim_val blit_     : string -> int -> string -> int -> int -> unit 
  7.                                                        = 5 "blit_string";
  8. in
  9.  
  10. type substring = string * int * int
  11. (* Invariant on values (s, i, n) of type substring:
  12.  *                  0 <= i <= i+n <= size s, 
  13.  * or equivalently, 0 <= i and 0 <= n and i+n <= size s.  
  14.  *)
  15.  
  16. fun base arg = arg
  17.     
  18. fun string (s, i, n) = 
  19.     let val newstr = mkstring_ n
  20.     in blit_ s i newstr 0 n; newstr end;
  21.  
  22. fun extract (s, i, NONE) =
  23.     if 0 <= i andalso i <= size s then (s, i, size s - i)
  24.     else raise General.Subscript
  25.   | extract (s, i, SOME n) =
  26.     if 0 <= i andalso 0 <= n andalso n <= size s - i then (s, i, n)
  27.     else raise General.Subscript
  28.  
  29. fun substring (s, i, n) = extract(s, i, SOME n);
  30.  
  31. fun all s = (s, 0, size s)
  32.  
  33. fun getc (s, i, 0) = NONE
  34.   | getc (s, i, n) = SOME(sub_ s i, (s, i+1, n-1))
  35.  
  36. fun first (s, i, n) = 
  37.     if n = 0 then NONE else SOME (sub_ s i);
  38.  
  39. fun isEmpty (s, i, n) = n=0;
  40.  
  41. fun triml k (s, i, n) = 
  42.     if k < 0 then raise Subscript
  43.     else if k > n then (s, i+n, 0) 
  44.     else (s, i+k, n-k);
  45.  
  46. fun trimr k (s, i, n) = 
  47.     if k < 0 then raise Subscript
  48.     else if k > n then (s, i, 0) 
  49.     else (s, i, n-k);
  50.  
  51. fun sub((s', i', n'), i) = 
  52.     if i<0 orelse i >= n' then raise Subscript
  53.     else sub_ s' (i'+i);
  54.  
  55. fun size (_, _, n) = n
  56.  
  57. fun slice ((s', i', n'), i, NONE) =
  58.     if 0 <= i andalso i <= n' then (s', i'+i, n'-i)
  59.     (* If the argument is valid, then so is the result:
  60.      *  0 <= i' <= i'+i <= i'+i + (n'-i) = i'+n' <= size s' *)
  61.     else raise Subscript
  62.   | slice ((s', i', n'), i, SOME n) =    
  63.     if 0 <= i andalso 0 <= n andalso i+n <= n' then (s', i'+i, n)
  64.     (* If the argument is valid, then so is the result:
  65.      *  0 <= i' <= i'+i <= i'+i + n <= i'+n' <= size s' *)
  66.     else raise Subscript
  67.  
  68. fun splitAt ((s, i, n), k) =
  69.     if k < 0 orelse k > n then raise Subscript
  70.     else ((s, i, k), (s, i+k, n-k));
  71.  
  72. fun concat strs =
  73.     let fun acc [] len                 = len
  74.           | acc ((_, _, len1)::vr) len = acc vr (len1 + len)
  75.         val len = acc strs 0
  76.         val newstr = if len > String.maxLen then raise Size else mkstring_ len 
  77.         fun copyall to []                   = () (* Now: to = len *)
  78.           | copyall to ((s1, i1, len1)::vr) = 
  79.         (blit_ s1 i1 newstr to len1; copyall (to+len1) vr)
  80.     in copyall 0 strs; newstr end;
  81.  
  82. fun compare ((s1, i1, n1), (s2, i2, n2)) =
  83.     let val stop = if n1 < n2 then n1 else n2
  84.     fun h j = (* At this point (s1, i1, j) = (s2, i2, j) *)
  85.         if j = stop then if      n1 < n2 then LESS
  86.                              else if n1 > n2 then GREATER
  87.                              else                 EQUAL
  88.         else
  89.         let val c1 = sub_ s1 (i1+j)
  90.             val c2 = sub_ s2 (i2+j)
  91.         in if c1 < c2 then LESS
  92.            else if c1 > c2 then GREATER
  93.            else h (j+1)
  94.         end
  95.     in h 0 end;
  96.  
  97. fun collate cmp ((s1, i1, n1), (s2, i2, n2)) =
  98.     let val stop = if n1 < n2 then n1 else n2
  99.     fun h j = (* At this point (s1, i1, j) = (s2, i2, j) *)
  100.         if j = stop then if      n1 < n2 then LESS
  101.                              else if n1 > n2 then GREATER
  102.                              else                 EQUAL
  103.         else
  104.         case cmp(sub_ s1 (i1+j), sub_ s2 (i2+j)) of
  105.             LESS    => LESS
  106.           | GREATER => GREATER
  107.           | EQUAL   => h (j+1)
  108.     in h 0 end;
  109.  
  110. fun foldl f e sus = Strbase.foldl f e sus;
  111.  
  112. fun foldr f e (s,i,n) = 
  113.     let fun h j res = if j<i then res 
  114.                       else h (j-1) (f (sub_ s j, res))
  115.     in h (i+n-1) e end;
  116.  
  117. fun explode (s, i, n) =
  118.     let fun h j res = if j<i then res
  119.               else h (j-1) (sub_ s j :: res)
  120.     in h (i+n-1) [] end;
  121.  
  122. fun app f ss = foldl (fn (x, _) => f x) () ss
  123.     
  124. local 
  125.     open Strbase 
  126. in
  127.     val splitl = splitl
  128.     val splitr = splitr
  129.     val dropl  = dropl
  130.     val dropr  = dropr
  131.     val takel  = takel
  132.     val taker  = taker
  133.     val translate = translate
  134.     val tokens = tokens
  135.     val fields = fields
  136. end
  137.  
  138. fun position s (s', i, n) =             
  139.     let val len = String.size s
  140.     fun eq j k = j >= len orelse 
  141.                  sub_ s j = sub_ s' k andalso eq (j+1) (k+1)
  142.     val stop = i+n-len
  143.     fun cmp k = if k>stop then (s', i+n, 0) (* failure *)
  144.             else if eq 0 k then (s', k, n-(k-i)) else cmp(k+1)
  145.     in cmp i end;
  146.     
  147.     (* Above, (eq j k)  means that  (s,j,len-j) = (s',k,len-j), 
  148.            so (eq 0 k)  implies     s = (s', k, len).
  149.        At successful termination, i <= k <= i+n-len, so 0 <= k-i <= n-len, 
  150.        and therefore n >= n-(k-i) >= len >= 0.  It follows that 
  151.        0 <= k <= k + n-(k-i) = n+i <= size s' (by SS(s', i, n) being valid),
  152.        so the resulting substring is valid.
  153.     *)
  154.        
  155. fun scanString scan (s, i, n) =
  156.     let fun getc k = if k >= n then NONE 
  157.              else SOME (sub_ s (i+k), k+1)
  158.     in case scan {getc=getc} i of
  159.     NONE          => NONE
  160.       | SOME (res, _) => SOME res
  161.     end
  162. end (* local *)
  163.